unit Charts;

interface

uses
  Classes, Graphics, Controls, ExtCtrls, WinTypes;

const
  chMaxYs = 4;

type
  TChart = class; { forward declaration }
  TChartSerie = class; { forward declaration }
  TChartOptions = set of (choGridX,choGridY,choGridInFront,choAutoExpandX,choAutoExpandY);

  TChartPoint = class
    Owner : TChartSerie;
    ID    : string[20];
    X     : extended;
    Y     : array [1..chMaxYs] of extended;
    constructor Create( AOwner: TChartSerie; PID: string; PX: extended; PY: array of extended );
    function IsEqual( p: TChartPoint ): boolean;
    function MinY: extended;
    function MaxY: extended;
  end;

  TChartStyle = (chsLines, chsMinMax);
  TChartSerieOptions = set of (csoDrawAllX,csoSteps,csoFilled,csoPointWidthProp);
  TChartSerieMarksStyle = (cmsNone, cmsCircle, cmsTriangle, cmsSquare);
  TChartSerie = class
  private
    { Private declarations }
    FChart      : TChart;
    FName       : string;
    FTitle      : string;
    FPoints     : TList;
    FLineColor  : TColor;
    FLineWidth  : integer;
    FFillColor  : TColor;
    FYsPerPoint : integer;
    FStyle      : TChartStyle;
    FOptions    : TChartSerieOptions;
    FMarksStyle : TChartSerieMarksStyle;
    FPointWidth : integer;
    FTag        : longint;
    function GetPoint( idx: integer ): TChartPoint;
    function GetPointCount: integer;
    procedure Paint( Canvas: TCanvas );
    procedure Change;
    function DeletePoint( ID: string ): boolean;
    procedure SetName( const n: string );
    procedure SetTitle( const t: string );
    procedure SetFillColor( c: TColor );
    procedure SetLineColor( c: TColor );
    procedure SetLineWidth( w: integer );
    procedure SetStyle( s: TChartStyle );
    procedure SetOptions( o: TChartSerieOptions );
    procedure SetMarksStyle( ms: TChartSerieMarksStyle );
    procedure SetPointWidth( w: integer );
    function  GetIndex: integer;
    procedure DefinePen( Canvas: TCanvas; w: integer );
    procedure DrawPointMark( Canvas: TCanvas; X,Y: integer );
    procedure PaintPointsGraphic(Canvas: TCanvas);
    procedure PaintLinesGraphic(Canvas: TCanvas);
    procedure PaintMinMaxGraphic(Canvas: TCanvas);
    procedure PaintAreaGraphic(Canvas: TCanvas);
  public
    { Public declarations }
    constructor Create( Owner: TChart; Name: string );
    destructor Destroy; override;
    procedure Clear;
    procedure RescanMinMax;
    function FindPoint( ID: string ): integer;
    function PointOfID( ID: string ): TChartPoint;
    function FindPointInPos( unX,unY,d: integer; var pnt,idx: integer ): boolean;
    procedure AddPoint( ID: string; X: extended; Y: array of extended );
    function DelPoint( ID: string ): boolean;
    procedure BeginUpdate;
    procedure EndUpdate;
    property Name: string read FName write SetName;
    property Title: string read FTitle write SetTitle;
    property Points[ idx: integer ]: TChartPoint read GetPoint;
    property PointCount: integer read GetPointCount;
    property YsPerPoint: integer read FYsPerPoint;
    property LineColor: TColor read FLineColor write SetLineColor;
    property LineWidth: integer read FLineWidth write SetLineWidth;
    property FillColor: TColor read FFillColor write SetFillColor;
    property Style: TChartStyle read FStyle write SetStyle;
    property Options: TChartSerieOptions read FOptions write SetOptions;
    property MarksStyle: TChartSerieMarksStyle read FMarksStyle write SetMarksStyle;
    property PointWidth: integer read FPointWidth write SetPointWidth;
    property Tag: longint read FTag write FTag;
    property Index: integer read GetIndex;
    property Owner: TChart read FChart;
  end;

  TChart = class
  private
    { Private declarations }
    FPaintBox    : TPaintBox;
    FSeries      : TList;
    FOfsX,FOfsY  : integer;
    FMinX, FMaxX : extended;
    FMinY, FMaxY : extended;
    FEscalaX     : extended;
    FEscalaY     : extended;
    FXisTime     : boolean;
    FFormatX     : string;
    FFormatY     : string;
    FOptions     : TChartOptions;
    FLock        : integer;
    FModified    : boolean;
    FLinesColor  : TColor;
    FSerieNames  : TStringList;
    FTag         : longint;
    FTitlesFont  : TFont;
    FChartRect   : TRect;
    FGraphRect   : TRect;
    FTitlesRect  : TRect;
    FOnChange    : TNotifyEvent;
    function GetSerie( idx: integer ): TChartSerie;
    function GetSerieCount: integer;
    procedure SetXisDateTime( b: boolean );
    procedure PaintBoxPaint( Sender: TObject );
    procedure CalcularEscala;
    procedure Change;
    function  GetLocked: boolean;
    procedure DeleteSerie( s: TChartSerie );
    procedure CalculateChartAreas;
    property  GraphRect: TRect read FGraphRect;
    property  TitlesRect: TRect read FTitlesRect;
    function  GraphHeight: integer;
    function  GraphWidth: integer;
    function  TitlesHeight: integer;
    function  TitlesWidth: integer;
    procedure SetTitlesFont( tf: TFont );
    procedure Paint(Canvas: TCanvas);
  public
    { Public declarations }
    constructor Create( PaintBox: TPaintBox );
    destructor Destroy; override;
    function AddSerie( Name: string ): TChartSerie;
    function FindSerie( Name: string ): integer;
    function SerieOfName( Name: string ): TChartSerie;
    procedure ClearSeries;
    procedure BeginUpdate;
    procedure EndUpdate;
    function  XToPixel( X: extended ): integer;
    function  YToPixel( Y: extended ): integer;
    function  PixelToX( X: integer ): extended;
    function  PixelToY( Y: integer ): extended;
    function  FormatedX( x: extended ): string;
    function  FormatedY( y: extended ): string;
    procedure RescanMinMax;
    procedure Refresh;
    function SerieNames: TStringList;
    function MoveSerieUp( idx: integer ): boolean;
    function MoveSerieDown( idx: integer ): boolean;
    procedure CopyToClipboard;
    function FindPointInPos( X,Y,d: integer; var pnt: TChartPoint; var idx: integer ): boolean;
    function ExistPointInPos( X,Y,d: integer ): boolean;
    property Series[ idx: integer ]: TChartSerie read GetSerie;
    property SerieCount: integer read GetSerieCount;
    property MinX: extended read FMinX write FMinX;
    property MaxX: extended read FMaxX write FMaxX;
    property MinY: extended read FMinY write FMinY;
    property MaxY: extended read FMaxY write FMaxY;
    property XisDateTime: boolean read FXisTime write SetXisDateTime;
    property Options: TChartOptions read FOptions write FOptions;
    property FormatX: string read FFormatX write FFormatX;
    property FormatY: string read FFormatY write FFormatY;
    property Locked: boolean read GetLocked;
    property Modified: boolean read FModified write FModified;
    property LinesColor: TColor read FLinesColor write FLinesColor;
    property Tag: longint read FTag write FTag;
    property TitlesFont: TFont read FTitlesFont write SetTitlesFont;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

implementation

uses
  SysUtils, StrTools, Windows, Clipbrd, CtrlTools;

function Sign( i: longint ): longint;
begin
  if i<>0 then result := i div abs(i)
          else result := 0;
end;

{ TChartPoint class }

constructor TChartPoint.Create( AOwner: TChartSerie; PID: string; PX: extended; PY: array of extended );
var
  i : integer;
begin
  inherited Create;
  Owner := AOwner;
  ID := PID;
  X  := PX;
  for i := 0 to high(PY) do Y[i+1]  := PY[i];
end;

function TChartPoint.IsEqual( p: TChartPoint ): boolean;
var
  i : integer;
begin
  result := (p.ID=ID) and (p.X=X);
  for i := 1 to Owner.YsPerPoint do
  begin
    if not result then exit;
    result := result and (p.Y[i]=Y[i]);
  end;
end;

function TChartPoint.MinY: extended;
var
  i : integer;
begin
  result := Y[1];
  for i := 2 to Owner.YsPerPoint do
    if Y[i]<result then result := Y[i];
end;

function TChartPoint.MaxY: extended;
var
  i : integer;
begin
  result := Y[1];
  for i := 2 to Owner.YsPerPoint do
    if Y[i]>result then result := Y[i];
end;

{ TChartSerie class }

procedure TChartSerie.SetName( const n: string );
begin
  if (FName=n) or (FChart.FindSerie(n)>=0) then exit;
  FName := n;
  Change;
end;

procedure TChartSerie.SetTitle( const t: string );
begin
  if FTitle=t then exit;
  FTitle := t;
  Change;
end;

procedure TChartSerie.SetLineColor( c: TColor );
begin
  if FLineColor=c then exit;
  FLineColor := c;
  Change;
end;

procedure TChartSerie.SetFillColor( c: TColor );
begin
  if FFillColor=c then exit;
  FFillColor := c;
  Change;
end;

procedure TChartSerie.SetLineWidth( w: integer );
begin
  if FLineWidth=w then exit;
  FLineWidth := w;
  if (csoPointWidthProp in FOptions) and (w>0) then FPointWidth := w*2;
  Change;
end;

procedure TChartSerie.SetPointWidth( w: integer );
begin
  if FPointWidth=w then exit;
  FPointWidth := w;
  Change;
end;

procedure TChartSerie.SetStyle( s: TChartStyle );
begin
  if FStyle=s then exit;
  FStyle := s;
  if s=chsMinMax then FYsPerPoint := 4
                 else FYsPerPoint := 1;
  Change;
end;

procedure TChartSerie.SetOptions( o: TChartSerieOptions );
begin
  if FOptions=o then exit;
  FOptions := o;
  Change;
end;

procedure TChartSerie.SetMarksStyle( ms: TChartSerieMarksStyle );
begin
  if FMarksStyle=ms then exit;
  FMarksStyle := ms;
  Change;
end;

function TChartSerie.GetPoint( idx: integer ): TChartPoint;
begin
  result := FPoints.Items[idx];
end;

function TChartSerie.GetPointCount: integer;
begin
  result := FPoints.Count;
end;

procedure TChartSerie.DrawPointMark( Canvas: TCanvas; X,Y: integer );
var
  w, r  : integer;
  bc,pc : TColor;
begin
  with FChart,FPaintBox.Canvas do
  begin
    bc := Brush.Color;
    Brush.Color := FFillColor;
    w := Pen.Width;
    pc := Pen.Color;
    Pen.Width := FPointWidth div 4;
    Pen.Color := FLineColor;
    r := FPointWidth div 2;
    case MarksStyle of
      cmsCircle:   Ellipse(X-r,Y-r,X+r,Y+r);
      cmsTriangle: Polygon([Point(X-r,Y-r),Point(X+r,Y-r),Point(X,Y+r)]);
      cmsSquare:   Polygon([Point(X-r,Y-r),Point(X+r,Y-r),Point(X+r,Y+r),Point(X-r,Y+r)]);
    end;
    Pen.Width := w;
    Pen.Color := pc;
    Brush.Color := bc;
  end;
end;

procedure TChartSerie.DefinePen( Canvas: TCanvas; w: integer );
begin
  with FChart, Canvas do
  begin
    Pen.Color := FLineColor;
    if w>0 then
    begin
      Pen.Style := psSolid;
      Pen.Width := w;
    end
    else if w=0  then Pen.Style := psClear
    else if w=-1 then
    begin
      Pen.Style := psDot;
      Pen.Width := 1;
    end;
  end;
end;

procedure TChartSerie.PaintPointsGraphic(Canvas: TCanvas);
var
  i : integer;
begin
  with FChart do
    for i := 0 to PointCount-1 do
      with Points[i] do
        DrawPointMark(Canvas,XToPixel(X),YToPixel(Y[1]));
end;

procedure TChartSerie.PaintLinesGraphic( Canvas: TCanvas );
var
  i : integer;
begin
  with FChart, Canvas do
  begin
    if PointCount>1 then
    begin
      with Points[0] do
        if (csoDrawAllX in Self.Options) and
           (X>MinX) then
        begin
          MoveTo(XToPixel(MinX),YToPixel(Y[1]));
          LineTo(XToPixel(X),YToPixel(Y[1]));
        end
        else
          MoveTo(XToPixel(X),YToPixel(Y[1]));
      if csoSteps in Self.Options then
        for i := 1 to PointCount-1 do
        begin
          LineTo(XToPixel(Points[i].X),YToPixel(Points[i-1].Y[1]));
          with Points[i] do
            LineTo(XToPixel(X),YToPixel(Y[1]));
        end
      else
        for i := 1 to PointCount-1 do
          with Points[i] do
            LineTo(XToPixel(X),YToPixel(Y[1]));
      if (csoDrawAllX in Self.Options) and
         (Points[PointCount-1].X<MaxX) then
        LineTo(XToPixel(MaxX),YToPixel(Points[PointCount-1].Y[1]));
    end
    else if PointCount=1 then
      with Points[0] do
        if (csoDrawAllX in Self.Options) then
        begin
          MoveTo(XToPixel(MinX),YToPixel(Y[1]));
          LineTo(XToPixel(MaxX),YToPixel(Y[1]));
        end
        else
        begin
          MoveTo(XToPixel(X),YToPixel(Y[1]));
          LineTo(XToPixel(X)+2,YToPixel(Y[1]));
        end;
  end;
end;

procedure TChartSerie.PaintMinMaxGraphic( Canvas: TCanvas );
var
  i,j : integer;
begin
  with FChart, Canvas do
  begin
    for i := 0 to PointCount-1 do
      with Points[i] do
      begin
        MoveTo(XToPixel(X),YToPixel(Y[3]));
        LineTo(XToPixel(X),YToPixel(Y[4]));
        MoveTo(XToPixel(X),YToPixel(Y[1]));
        LineTo(XToPixel(X)+FLineWidth,YToPixel(Y[1]));
        MoveTo(XToPixel(X),YToPixel(Y[2]));
        LineTo(XToPixel(X)-FLineWidth,YToPixel(Y[2]));
        if Self.MarksStyle<>cmsNone then
        begin
          DrawPointMark(Canvas,XToPixel(X),YToPixel(Y[3]));
          DrawPointMark(Canvas,XToPixel(X),YToPixel(Y[4]));
          DrawPointMark(Canvas,XToPixel(X)+FLineWidth*2,YToPixel(Y[1]));
          DrawPointMark(Canvas,XToPixel(X)-FLineWidth*2,YToPixel(Y[2]));
        end;
      end;
  end;
end;

procedure TChartSerie.PaintAreaGraphic( Canvas: TCanvas );
type
  PPoints = ^TPoints;
  TPoints = array[0..0] of TPoint;
var
  i  : integer;
  pt : PPoints;
  cp : integer;
  pp : integer;
  bc : TColor;
  procedure AddPoint( X,Y: integer );
  begin
    pt^[pp] := Point(X,Y);
    inc(pp);
  end;
begin
  with FChart, Canvas do
  begin
    Pen.Color := FFillColor;
    Pen.Width := 1;
    bc := Brush.Color;
    Brush.Color := FFillColor;
    Brush.Style := bsSolid;
    if csoSteps in Self.Options then cp := PointCount*2-1+4
                                else cp := PointCount+4;
    GetMem(pt,cp*SizeOf(TPoint));
    pp := 0;
    AddPoint(XToPixel(MinX),YToPixel(MinY)-1);
    if PointCount>1 then
    begin
      with Points[0] do
        if (X>MinX) then
        begin
          AddPoint(XToPixel(MinX),YToPixel(Y[1]));
          AddPoint(XToPixel(X),YToPixel(Y[1]));
        end
        else
          AddPoint(XToPixel(X),YToPixel(Y[1]));
      if csoSteps in Self.Options then
        for i := 1 to PointCount-1 do
        begin
          AddPoint(XToPixel(Points[i].X),YToPixel(Points[i-1].Y[1]));
          with Points[i] do
            AddPoint(XToPixel(X),YToPixel(Y[1]));
        end
      else
        for i := 1 to PointCount-1 do
          with Points[i] do
            AddPoint(XToPixel(X),YToPixel(Y[1]));
      if Points[PointCount-1].X<MaxX then
        AddPoint(XToPixel(MaxX),YToPixel(Points[PointCount-1].Y[1]));
    end
    else if PointCount=1 then
      with Points[0] do
      begin
        AddPoint(XToPixel(MinX),YToPixel(Y[1]));
        AddPoint(XToPixel(MaxX),YToPixel(Y[1]));
      end;
    AddPoint(XToPixel(MaxX),YToPixel(MinY)-1);
    Windows.Polygon(FPaintBox.Canvas.Handle, pt^, pp);
    FreeMem(pt,cp*SizeOf(TPoint));
    Brush.Color := bc;
  end;
end;

procedure TChartSerie.Paint( Canvas: TCanvas );
begin
  if PointCount=0 then exit;
  case FStyle of
    chsLines:  begin
                 if csoFilled in Self.Options then PaintAreaGraphic(Canvas);
                 DefinePen(Canvas,FLineWidth);
                 PaintLinesGraphic(Canvas);
                 if Self.MarksStyle<>cmsNone then
                 begin
                   DefinePen(Canvas,FPointWidth);
                   PaintPointsGraphic(Canvas);
                 end;
               end;
    chsMinMax: begin
                 if csoFilled in Self.Options then PaintAreaGraphic(Canvas);
                 DefinePen(Canvas,FLineWidth);
                 PaintMinMaxGraphic(Canvas);
                 if not (csoFilled in Self.Options) then
                 begin
                   DefinePen(Canvas,-1);
                   PaintLinesGraphic(Canvas);
                 end;
               end;
  end;
end;

procedure TChartSerie.Change;
begin
  FChart.Change;
end;

procedure TChartSerie.BeginUpdate;
begin
  FChart.BeginUpdate;
end;

procedure TChartSerie.EndUpdate;
begin
  FChart.EndUpdate;
end;

constructor TChartSerie.Create( Owner: TChart; Name: string );
begin
  inherited Create;
  FPoints := TList.Create;
  FChart := Owner;
  FName := Name;
  FLineWidth := 2;
  FPointWidth := FLineWidth*2;
  FStyle := chsLines;
  FYsPerPoint := 1;
  FMarksStyle := cmsNone;
end;

destructor TChartSerie.Destroy;
begin
  Clear;
  FPoints.Free;
  FChart.DeleteSerie(Self);
  inherited Destroy;
end;

procedure TChartSerie.Clear;
var
  i : integer;
begin
  for i := 0 to FPoints.Count-1 do
    TChartPoint(FPoints.Items[i]).Free;
  FPoints.Clear;
  Change;
end;

function TChartSerie.FindPoint( ID: string ): integer;
begin
  for result := 0 to FPoints.Count-1 do
    if TChartPoint(FPoints.Items[result]).ID=ID then exit;
  result := -1;
end;

function TChartSerie.PointOfID( ID: string ): TChartPoint;
var
  i : integer;
begin
  i := FindPoint(ID);
  if i>=0 then result := FPoints.Items[i]
          else result := nil;
end;

function TChartSerie.FindPointInPos( unX,unY,d: integer; var pnt,idx: integer ): boolean;
var
  r         : TRect;
  px,py,i,j : integer;
  cp        : TChartPoint;
begin
  result := false;
  if (FChart.FEscalaX<=0) or (FChart.FEscalaY<=0) then exit;
  r := Rect(unX-d,unY-d,unX+d,unY+d);
  for i := 0 to PointCount-1 do
  begin
    cp := Points[i];
    px := FChart.XToPixel(cp.X);
    for j := 1 to YsPerPoint do
    begin
      py := FChart.YToPixel(cp.Y[j]);
      if (px>=r.Left) and (px<=r.Right) and
         (py>=r.Top) and (py<=r.Bottom) then
      begin
        result := true;
        pnt := i; idx := j;
        exit;
      end;
    end;
  end;
end;

procedure TChartSerie.AddPoint( ID: string; X: extended; Y: array of extended );
var
  i   : integer;
  ins : boolean;
  p   : TChartPoint;
  m   : extended;
begin
  p := TChartPoint.Create(Self,ID,X,Y);
  {Si el punto esta y es igual me voy}
  i := FindPoint(ID);
  if i>=0 then
  begin
    if points[i].IsEqual(p) then
    begin
      p.Free;
      exit;
    end;
    TChartPoint(FPoints.Items[i]).Free;
    FPoints.Delete(i);
    {FPoints.Pack;}
  end;
  if (not (choAutoExpandX in FChart.Options) and
     ((X<FChart.FMinX) or (X>FChart.FMaxX))) or
     (not (choAutoExpandY in FChart.Options) and
     ((p.MinY<FChart.FMinY) or (p.MaxY>FChart.FMaxY)))
  then
  begin
    p.Free;
    exit;
  end;
  {Mode Anfossi OFF}
  ins := false;
  for i := 0 to PointCount-1 do
    if X<Points[i].X then
    begin
      FPoints.Insert(i,p);
      ins := true;
      break;
    end;
  if not ins then FPoints.Add(p);
  with FChart,GraphRect do
  begin
    if choAutoExpandX in Options then
    begin
      if X<FMinX*1.0005 then FMinX := X/1.0005;
      if X>FMaxX/1.0005 then FMaxX := X*1.0005;
    end;
    if choAutoExpandY in Options then
    begin
      m := p.MinY;
      if m<FMinY*1.0005 then FMinY := m/1.0005;
      m := p.MaxY;
      if m>FMaxY/1.0005 then FMaxY := m*1.0005;
    end;
  end;
  Change;
end;

procedure TChartSerie.RescanMinMax;
var
  i : integer;
  mi,ma : extended;
begin
  i := 0;
  while i<=PointCount-1 do
    with Points[i],FChart do
    begin
      if (choAutoExpandX in Options) then
      begin
        if X<FMinX*1.0005 then FMinX := X/1.0005;
        if X>FMaxX/1.0005 then FMaxX := X*1.0005;
      end
      else if (X<FMinX) or (X>FMaxX) then
      begin
        Points[i].Free;
        FPoints.Delete(i);
        continue;
      end;
      mi := Points[i].MinY;
      ma := Points[i].MaxY;
      if choAutoExpandY in Options then
      begin
        if mi<FMinY*1.0005 then FMinY := mi/1.0005;
        if ma>FMaxY/1.0005 then FMaxY := ma*1.0005;
      end
      else if (mi<FMinY) or (ma>FMaxY) then
      begin
        Points[i].Free;
        FPoints.Delete(i);
        continue;
      end;
      inc(i);
    end;
end;

function TChartSerie.DeletePoint( ID: string ): boolean;
var
  i : integer;
begin
  i := FindPoint(ID);
  if i>=0 then
  begin
    TChartPoint(FPoints.Items[i]).Free;
    FPoints.Delete(i);
    {FPoints.Pack;}
    result := true;
  end
  else result := false;
end;

function TChartSerie.DelPoint( ID: string ): boolean;
begin
  result := DeletePoint(ID);
  if result then Change;
end;

function TChartSerie.GetIndex: integer;
begin
  result := FChart.FSeries.IndexOf(Self);
end;

{*************************************************************************************}
{ TChart class                                                                        }
{*************************************************************************************}

function TChart.GetSerie( idx: integer ): TChartSerie;
begin
  result := FSeries.Items[idx];
end;

function TChart.GetSerieCount: integer;
begin
  result := FSeries.Count;
end;

procedure TChart.DeleteSerie( s: TChartSerie );
begin
  FSeries.Remove(s);
  Change;
end;

function  TChart.GetLocked: boolean;
begin
  result := FLock>0;
end;

procedure TChart.SetXisDateTime( b: boolean );
begin
  if FXIsTime=b then exit;
  FXIsTime := b;
  if FXIsTime then FFormatX := 'hh:nn'
              else FFormatX := '#,###,###,##0.0';
  Change;
end;

procedure TChart.SetTitlesFont( tf: TFont );
begin
  FTitlesFont.Assign(tf);
  Change;
end;

function TChart.FormatedX( x: extended ): string;
begin
  if XisDateTime then
    result := FormatDateTime(FFormatX,x)
  else
    result := FormatFloat(FFormatX,x);
end;

function TChart.FormatedY( y: extended ): string;
begin
  result := FormatFloat(FFormatY,y);
end;

procedure TChart.CalculateChartAreas;
  function CalcTitlesRect: TRect;
  var
    f : TFont;
  begin
    f := TFont.Create;
    f.assign(FPaintBox.Canvas.Font);
    FPaintBox.Canvas.Font := FTitlesFont;
    result := FPaintBox.ClientRect;
    result.Left := FOfsX;
    result.Right := result.Right-FOfsX;
    result.Bottom := {FOfsY+}4+SerieCount*FPaintBox.Canvas.TextHeight('X')-1;
    FPaintBox.Canvas.Font := f;
    f.Free;
  end;
begin
  FTitlesRect := CalcTitlesRect;
  FGraphRect := FPaintBox.ClientRect;
  FGraphRect.Top := FTitlesRect.Bottom;
end;

{function  TChart.GraphRect: TRect;
begin
  result := FGraphRect;
end;

function  TChart.TitlesRect: TRect;
begin
  result := FTitlesRect;
end;}

function  TChart.GraphHeight: integer;
begin
  with GraphRect do
    result := Bottom-Top;
end;

function  TChart.GraphWidth: integer;
begin
  with GraphRect do
    result := Right-Left;
end;

function  TChart.TitlesHeight: integer;
begin
  with TitlesRect do
    result := Bottom-Top;
end;

function  TChart.TitlesWidth: integer;
begin
  with TitlesRect do
    result := Right-Left;
end;

procedure TChart.Paint( Canvas: TCanvas );
var
  i     : integer;
  y0,x0 : integer;
  x     : string;
  function YWidth( y: extended ): integer;
  begin
    with Canvas do
      try
        result := TextWidth(FormatFloat(FFormatY,y))+3;
      except
        result := 0;
      end;
  end;
  procedure DibujarSeries;
  var
    i : integer;
  begin
    for i := FSeries.Count-1 downto 0 do
      TChartSerie(FSeries.Items[i]).Paint(Canvas);
  end;
  procedure DibujarTitulos;
  var
    i,s,y : integer;
    r : TRect;
  begin
    r := TitlesRect;
    with Canvas,r do
    begin
      {Brush.Color := clRed;}
      {FillRect(r);}
      Font := FTitlesFont;
      Font.Color := FLinesColor;
      s := TextHeight('X');
      for i := 0 to SerieCount-1 do
      begin
        y := {FOfsY}2+top+s*i+(s div 2);
        Pen.Color := Series[i].LineColor;
        Pen.Width := Series[i].LineWidth;
        MoveTo(left+0,y);
        LineTo(left+20,y);
        Series[i].DrawPointMark(Canvas,left+20,y);
        Brush.Style := bsClear;
//        TextOut(left+35,{FOfsY}2+top+s*i,Series[i].Title);
        TextRect(r,left+35,{FOfsY}2+top+s*i,Series[i].Title);
        Brush.Style := bsSolid;
      end;
    end;
  end;
begin
  with Canvas,GraphRect do
  begin
    {DibujarTitulos;}
    Font.Name := 'Small Fonts';
    Font.Size := 7;
    {FOfsX := YWidth(FMaxY)+10;
    i := YWidth(FMinY)+10;}
    i := YWidth(FMaxY)+3;
    if i>FOfsX then FOfsX := i;
    {inc(FOfsX,2);}
    CalcularEscala;
    Brush.Style := bsSolid;
    Brush.Color := FPaintBox.Color;
    FillRect(FPaintBox.ClientRect);
    DibujarTitulos;
    if choGridInFront in FOptions then DibujarSeries;
    { Dibujar ejes, etc. }
    Font.Color := FLinesColor;
    Pen.Color := FLinesColor;
    Pen.Width := 2;
    Pen.Style := psSolid;
    Brush.Style := bsClear;
    if (FEscalaX<=0) or (FEscalaY<=0) then exit;
    if FMinX<=0 then x0 := XToPixel(0)
                else x0 := XToPixel(FMinX);
    MoveTo(x0,top{*}+FOfsY);
    LineTo(x0,bottom-FOfsY);
    if FMinY<=0 then
    begin
      y0 := YToPixel(0);
      x := FormatFloat(FFormatY,0);
    end
    else
    begin
      y0 := YToPixel(FMinY);
      x := FormatFloat(FFormatY,FMinY);
    end;
    TextOut(left{*}+FOfsX-TextWidth(x)-3,y0-4,x);
    MoveTo(left{*}+FOfsX,y0);
    LineTo(right-FOfsX,y0);
    Pen.Width := 1;
    Pen.Style := psDot;
    { Grilla Y }
    i := y0-20;
    while i>top{*}+FOfsY do
    begin
      x := FormatFloat(FFormatY,PixelToY(i));
      TextOut(left{*}+FOfsX-TextWidth(x)-3,i-4,x);
      if choGridX in FOptions then
      begin
        MoveTo(left{*}+FOfsX,i);
        LineTo(right-FOfsX,i);
      end
      else
      begin
        MoveTo(x0-2,i);
        LineTo(x0+2,i);
      end;
      dec(i,20);
    end;
    i := y0+20;
    while i<Bottom-FOfsY do
    begin
      x := FormatFloat(FFormatY,PixelToY(i));
      TextOut(left{*}+FOfsX-TextWidth(x)-3,i-4,x);
      if choGridX in FOptions then
      begin
        MoveTo(left{*}+FOfsX,i);
        LineTo(right-FOfsX,i);
      end
      else
      begin
        MoveTo(x0-2,i);
        LineTo(x0+2,i);
      end;
      inc(i,20);
    end;
    { Grilla X }
    i := x0+40;
    while i<Right-FOfsX do
    begin
      if FXisTime then x := FormatDateTime(FFormatX,PixelToX(i))
                  else x := FormatFloat(FFormatX,PixelToX(i));
      TextOut(i-TextWidth(x) div 2,y0+1,x);
      if choGridY in FOptions then
      begin
        MoveTo(i,top{*}+FOfsY);
        LineTo(i,bottom-FOfsY);
      end
      else
      begin
        MoveTo(i,y0-2);
        LineTo(i,y0+2);
      end;
      inc(i,40);
    end;
    i := x0-40;
    while i>left{*}+FOfsX do
    begin
      if FXisTime then x := FormatDateTime(FFormatX,PixelToX(i))
                  else x := FormatFloat(FFormatX,PixelToX(i));
      TextOut(i-TextWidth(x) div 2,y0+1,x);
      if choGridY in FOptions then
      begin
        MoveTo(i,top{*}+FOfsY);
        LineTo(i,bottom-FOfsY);
      end
      else
      begin
        MoveTo(i,y0-2);
        LineTo(i,y0+2);
      end;
      dec(i,40);
    end;
    Pen.Style := psSolid;
    Brush.Style := bsSolid;
    { Dibujar las Series }
    if not (choGridInFront in FOptions) then DibujarSeries;
    FModified := false;
  end;
end;

procedure TChart.CalcularEscala;
begin
  try
    FEscalaX := (FMaxX-FMinX)/(GraphWidth-FOfsX*2);
  except
    FEscalaX := 0
  end;
  try
    FEscalaY := (FMaxY-FMinY)/(GraphHeight-FOfsY*2);
  except
    FEscalaY := 0
  end;
end;

procedure TChart.PaintBoxPaint( Sender: TObject );
begin
  CalculateChartAreas;
  Paint((Sender as TPaintBox).Canvas);
end;

procedure TChart.Change;
begin
  FModified := true;
  if FLock>0 then exit;
  //FPaintBox.Invalidate;
  if assigned(FOnChange) then FOnChange(Self); 
end;

procedure TChart.Refresh;
begin
  FPaintBox.Invalidate;
end;

procedure TChart.BeginUpdate;
begin
  inc(FLock);
end;

procedure TChart.EndUpdate;
begin
  if FLock=0 then exit;
  dec(FLock);
  if (FLock=0) and FModified then Change;
end;

function TChart.XToPixel( X: extended ): integer;
begin
  result := GraphRect.Left+FOfsX+Trunc((X-FMinX)/FEscalaX);
end;

function TChart.YToPixel( Y: extended ): integer;
begin
  result := GraphRect.Bottom-FOfsY-Trunc((Y-FMinY)/FEscalaY);
end;

function TChart.PixelToX( X: integer ): extended;
begin
  result := FMinX+(X-FOfsX-GraphRect.Left)*FEscalaX;
end;

function TChart.PixelToY( Y: integer ): extended;
begin
  result := FMinY+(GraphRect.Bottom-FOfsY-Y)*FEscalaY;
end;

procedure TChart.RescanMinMax;
var
  i : integer;
begin
  if choAutoExpandY in Options then
  begin
    FMinY := 1e38;
    FMaxY := -1e38;
  end;
  if choAutoExpandX in Options then
  begin
    FMinX := 1e38;
    FMaxX := -1e38;
  end;
  for i := 0 to SerieCount-1 do
    Series[i].RescanMinMax; 
  Change;
end;

constructor TChart.Create( PaintBox: TPaintBox );
begin
  inherited Create;
  FOfsX := 12;
  FOfsY := 12;
  FPaintBox := PaintBox;
  FSeries := TList.Create;
  FFormatX := '#,###,###,##0.0';
  FFormatY := '#,###,###,##0.0';
  FPaintBox.OnPaint := PaintBoxPaint;
  FLinesColor := clBlack;
  FTitlesFont := TFont.Create;
  with FTitlesFont do
  begin
    Name := 'Small Fonts';
    Size := 7;
  end;
end;

destructor TChart.Destroy;
begin
  BeginUpdate;
  while FSeries.Count>0 do
    TChartSerie(FSeries.Items[0]).Free;
  FSeries.Free;
  FSerieNames.Free;
  FTitlesFont.Free;
  inherited Destroy;
end;

function TChart.AddSerie( Name: string ): TChartSerie;
begin
  if FindSerie(Name)<0 then
  begin
    result := TChartSerie.Create(Self,Name);
    FSeries.Add(result);
    Change;
  end
  else result := nil;
end;

function TChart.FindSerie( Name: string ): integer;
begin
  for result := 0 to FSeries.Count-1 do
    if TChartSerie(FSeries.Items[result]).Name=Name then exit;
  result := -1;
end;

function TChart.SerieOfName( Name: string ): TChartSerie;
var
  i : integer;
begin
  i := FindSerie(Name);
  if i>=0 then result := FSeries.Items[i]
          else result := nil;
end;

procedure TChart.ClearSeries;
var
  i : integer;
begin
  for i := 0 to FSeries.Count-1 do
    TChartSerie(FSeries.Items[i]).Clear;
  Change;
end;

function TChart.SerieNames: TStringList;
var
  i : integer;
begin
  FSerieNames.Free;
  FSerieNames := TStringList.Create;
  for i := 0 to SerieCount-1 do
    FSerieNames.AddObject(Series[i].Name,Series[i]);
  result := FSerieNames;
end;

function TChart.MoveSerieUp( idx: integer ): boolean;
begin
  result := false;
  if idx<=0 then exit;
  FSeries.Move(idx,idx-1);
  Change;
  result := true;
end;

function TChart.MoveSerieDown( idx: integer ): boolean;
begin
  result := false;
  if idx>=FSeries.Count-1 then exit;
  FSeries.Move(idx,idx+1);
  Change;
  result := true;
end;

procedure TChart.CopyToClipboard;
var
  i : integer;
  l : TStringList;
  t : pchar;
  procedure CopySerie( serie: TChartSerie );
  var
    i,j : integer;
    s   : string;
  begin
    with serie do
    begin
      l.Add(serie.Title);
      for i := 0 to PointCount-1 do
      begin
        s := FormatedX(Points[i].X);
        for j := 1 to serie.YsPerPoint do
          s := s+#9+FormatedY(Points[i].Y[j]);
        l.Add(s);
      end;
      l.Add('');
    end;
  end;
begin
  l := TStringList.Create;
  for i := 0 to SerieCount-1 do
    CopySerie(Series[i]);
  t := l.GetText;
  Clipboard.Open;
  Clipboard.Assign(GetControlImage(FPaintBox.Parent));
  Clipboard.SetTextBuf(t);
  Clipboard.Close;
  l.Free;
  StrDispose(t);
end;

function TChart.FindPointInPos( X,Y,d: integer; var pnt: TChartPoint; var idx: integer ): boolean;
var
  i,j : integer;
begin
  for i := 0 to SerieCount-1 do
    with Series[i] do
      if FindPointInPos(X,Y,d,j,idx) then
      begin
        result := true;
        pnt := Points[j];
        exit;
      end;
  result := false;
  pnt := nil;
  idx := -1;
end;

function TChart.ExistPointInPos( X,Y,d: integer ): boolean;
var
  p : TChartPoint;
  i : integer;
begin
  result := FindPointInPos(X,Y,d,p,i);
end;

end.
